# Author: Damian 'Rush' Kaczmarek
# License: MIT

package Core;
use strict;
use Time::HiRes qw(time);
use Timer;
use Util;

$|=1;

# CONFIG ###################################
BEGIN {
	$Core::configfile = ".config";
}

# At least one config module has to be provided
require ConfigFile;

###########################################

my @servers = split(/\s*,\s*/, Config::get('server', 'krakow.ircnet.pl:6667,warszawa.ircnet.pl:6667'));
my %server_failures; # How many times each server has failed to connect to
$Core::server    = $servers[0];
$Core::nickname  = Config::get('nickname', 'nimfomanka');
$Core::realname  = Config::get('realname', 'Nimfo <3 you');
$Core::username  = Config::get('username', 'nimfomanka');
$Core::password  = Config::get('password');
$Core::antiflood = Config::get('antiflood', '0.5');
$Core::localaddr = Config::get('localaddr', '');
$Core::channel   = Config::get('channel');
$Core::maxretries = Config::get('maxretries', 3);
$Core::cooldowntime = Config::get('cooldowntime', 30);
$Core::commandregexp = Config::get('commandregexp', '^!(\w+)(?: (.*))?');

my @confmodules = split(/,/, Config::get('modules'));
my %mod_loaded;    # Currently loaded module. Module names are keys and values is the dependency counter.
my (%mod_deps, %mod_depended);    # Holds module dependencies
my %mod_commands; # Currently defined commands

use Time::HiRes qw(sleep);
use POSIX qw(strftime);
use UNIVERSAL qw(isa);

use POE;
use POE::Kernel;
use POE::Component::IRC;
use POE::Component::IRC::State;
use POE::Component::IRC::Common qw(parse_user);

my $DOWARN = 1;
BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN } }


my @names;

# catch some nasty signals for graceful quit
$SIG{'INT'}  = \&cleanup;
$SIG{'TERM'} = \&cleanup;

sub module_depended
{
	return $mod_depended{$_[0]};
}

sub module_dependencies
{
	return $mod_deps{$_[0]};
}

sub loaded_modules
{
	return keys(%mod_loaded);
}

sub load_module
{
	print "Loading $_[0] ...\n";
	if ($mod_loaded{$_[0]}) {
		print "Failed! Module already loaded.\n";
		return -1;
	}
	if ($mod_deps{$_[0]}) {    # Package was already loaded before
		foreach my $package (keys(%{$mod_deps{$_[0]}})) {
			$mod_depended{$package}{$_[0]} = 1;
		}
	}
	eval("use " . $_[0] . ";");

	#    eval('$mod_loaded{$_[0]} = new '.$_[0].';');
	if ($@) {
		print "Error!\n";
		print $@;
		$mod_loaded{$_[0]} = 0;    # In case the module managed to set it to 1
		return -2;
	}
	eval($_[0] . "::on_load();");      # TODO: error checking for on_load() subroutine

	#    print $mod_loaded{$_[0]};
	if($mod_loaded{$_[0]}) {
		print "$_[0] loaded\n";
		return 1;
	}
	else {
		print "$_[0] failed to load\n";
		return 0;
	}
}

sub unload_module
{
	print "Unloading $_[0] ... ";
	delete $INC{$_[0]};

	if ($mod_loaded{$_[0]} == 0) {
		print "Failed! Module not loaded.\n";
		return -2;
	}
	if ($mod_depended{$_[0]}) {
		if (keys(%{$mod_depended{$_[0]}}) > 0) {
			print "Failed! The following modules depend on this one: "
			  . join(", ", keys(%{$mod_depended{$_[0]}})) . "\n";
			return -1;
		}
	}
	eval($_[0] . "::on_unload();");
	$mod_loaded{$_[0]} = 0;
	print "OK\n";

	foreach my $package (keys(%{$mod_deps{$_[0]}})) {
		delete $mod_depended{$package}{$_[0]};
	}
	
	return 0;
}

# Every module that wants to get Core events should call this function
# No arguments are required, just call from the right package
sub register_module
{
	my $package   = $_[0];
	my $dependant = caller(1);
	$mod_loaded{$package}++; # Each use/require will increment this and thus we can indirectly check if it is depended upon by other packages
	if ($dependant ne 'Core') {
		$mod_deps{$dependant}{$package}     = 1;
		$mod_depended{$package}{$dependant} = 1;
	}
}

sub register_command
{
	my ($command, $module, $data) = @_;
	$data->{module} = $module;

	# allow for providing command synonyms with |
	foreach my $command (split /\|/, $command) {
		push(@{$mod_commands{$command}}, $data);
	}
}

foreach (@confmodules) {
	load_module($_);
}

Config::save();    # Gently create the config file if not exists

my $conn;
my @pings;

sub on_start {
	my ($kernel) = ($_[KERNEL]);
	$kernel->alarm( tick => time() + 1, 0 ); # initialize idle loop
	try_connect();
}



POE::Session->create(
	inline_states => {
		tick => sub {
			my $kernel = $_[KERNEL];
			on_idle();
			$kernel->alarm( tick => time() + 1, $_[0] + 1 );
		},
		retry_connect => sub { try_connect(); },
		_start => \&on_start, 
		irc_socketerr => \&on_socketerr, 
		irc_error => \&on_error, 
		irc_001 => \&on_connect, 
		irc_disconnected => \&on_disconnect, 
		irc_public => \&on_public, 
		irc_msg => \&on_privmsg,
		irc_352 => \&on_who,
		irc_315 => \&on_endwho,
		irc_join => \&on_join,
		irc_part => \&on_part,
		irc_notice => \&on_notice,
		irc_433 => \&on_nicktaken,
		irc_topic => \&on_topic,
		irc_ping => \&on_ping,
		irc_pong => \&on_pong,
		irc_331  => \&on_notopic,
#		irc_332 => \&on_topic,
		irc_nick => \&on_nick,
		irc_mode => \&on_mode,
		irc_quit => \&on_quit,
		auto_ping => sub {
			my $kernel = @_[KERNEL];
			my $time = time();
			$conn->yield('ping' => $time);
#			print "Auto ping\n";
			push(@pings, $time);

			$kernel->delay( ping_timeout => 60 );
		},
		ping_timeout => sub {
			print "Ping timeout!\n";
			stop_ping(@_);
			$conn->disconnect();
			rotate_server(@_);
			try_connect(@_);
		}
	}
);

sub rotate_server
{
	push(@servers, shift(@servers));
	$Core::server = $servers[0];
}

sub try_connect
{
	if ($conn) {
		$conn->yield( unregister => 'all' );

		undef($conn);
	}

	print "Trying " . $Core::server . " ... ";

	$Core::server =~ /(\S+):(\d+)/;

	$conn = POE::Component::IRC::State->spawn(
		Nick   => $Core::nickname,
		Server => $1,
		Port		=> $2,
		Username	=> $Core::username,
	    LocalAddr	=> $Core::localaddr,
		Ircname => "Nimfomanka IRC BOT"
	);

	$conn->yield( register => 'all' );
	$conn->yield( connect => { } );
	$conn->yield( join => $Core::channel );
}

sub do_callback
{
	(my $event, my $data) = @_;

	foreach my $module (keys(%mod_loaded)) {

		if ($mod_loaded{$module}) {
			if (isa($data, 'ARRAY')) {
				eval($module . '::on_' . $event . '(@{$data});');
			}
			else {
				eval($module . '::on_' . $event . '($data);');
			}			

			# Skip unimplemented event errors
			my $errorstr = "Undefined subroutine &" . $module . "::on_" . $event;
			if (!($@ =~ /$errorstr/)) {
				print $@;
			}
		}
	}
}

# Returns a timestamp
sub timestamp
{
	return strftime("[%a %b %e %Y] [%H:%M:%S]", localtime);
}

# Returns a list of people present on the channel
sub get_names
{
	my @nicklist = $conn->channel_list($Core::channel);
	return @nicklist;
}

# Return a long nick form for a given nick (for example nick!login@host)
sub get_nick_long {
	my ($nick) = @_;
	return $conn->nick_long_form($nick);
}


# Sends an ordinary message to the channel
sub send_msg
{
	my ($msg) = @_[0];

	my $mynick = $conn->nick_name();

	do_callback('sendmsg', [$mynick, $msg]);

	$conn->yield(privmsg => $Core::channel, $msg);
}

# Sends an ordinary message to the channel
sub send_notice
{
	my ($to, $msg) = @_;

	my $mynick = $conn->nick_name();

	do_callback('sendnotice', [$to, $msg]);

	$conn->yield(notice => $to, $msg);
}

# Changes a topic of the channel
sub set_topic
{
	my $topic    = $_[0];
	my $mynick = $conn->nick_name();

	do_callback('settopic', [$mynick, $topic]);
	$conn->yield(topic => $Core::channel, $topic);
}

sub topic
{
	return $conn->channel_topic($Core::channel)->{Value};
}

sub nickname
{
	return $conn->nick_name();
}

# Sends a private message to someone
sub send_priv
{
#	my $mynick = $conn->{_nick};
	my $nick   = $_[0];
	my $msg    = $_[1];
	my ($nick, $msg) = (@_);
#	$conn->privmsg($nick, $msg);

	sleep($Core::antiflood);
}

# Sends a '/me' message to the channel
sub send_me {
	my $msg    = $_[0];
	my $mynick = $conn->{_nick};
	my ($msg) = @_;

	do_callback('sendme', [$mynick, $msg]);

	$conn->me($conn->{channel}, $msg);

	sleep($Core::antiflood);
}

use Getopt::Long qw(GetOptionsFromString);
Getopt::Long::Configure ("bundling");
use Data::Dumper;
sub handle_command {
	my ($nick, $command, $rest) = @_;

	if(defined($mod_commands{$command})) {

		foreach my $data (@{$mod_commands{$command}}) {
			if($mod_loaded{$data->{module}}) {
				my %h;
				$DOWARN = 0;
				my @args = @{$data->{args}};

				my $skip_event = 0;

				if($data->{help}) {
					push(@args, "help|h:s" => sub {
						shift;
						my $arg = $_[0];


						print Dumper($data->{help});
						if($arg ne '' and $data->{help}->{$arg}) {
							my $help = $data->{help}->{$arg};
							Core::send_msg($help);

							$skip_event = 1;
							return;
						}
						my $help = $data->{help};
						Core::send_msg($help->{about}) if($help->{about});
						Core::send_msg("Usage: $command " . $help->{usage}) if($help->{usage});
						my @options;
						foreach my $key (keys(%{$data->{help}}) ) {
							next if($key =~ /^help_|about$|usage$|example$/);
#							Core::send_msg($key);
							push(@options, $key);
						}
						Core::send_msg("Options: " . join(", ", @options));
						Core::send_msg("Example: $command " . $help->{example}) if($help->{example});
						$skip_event = 1;
					} );

				}
				my ($ret, $remaining_args) = GetOptionsFromString($rest, \%h, @args);
				$h{_raw} = $rest;
				$DOWARN = 1;
				
				$data->{callback}->($nick, \%h, @{$remaining_args}) if (!$skip_event);
			}
		}
	}
}

sub on_public {
	my ($user, $where, $what) = @_[ARG0 .. ARG2];
	my $nick = parse_user($user);
	
	if($what =~ /$Core::commandregexp/) {
		handle_command($nick, $1, $2);
	}
	do_callback('public', [$nick, $what]);
}

# Note: Nick managment is now done by POE::Component::IRC::State
sub on_who {
	my ($server, $data) = @_[ARG0..ARG1];
	my $nick = ( split / /, $data )[4];
	my $code = ( split / /, $data )[5];
	if ( $code =~ /\@/ ) { $code = '@'; }
	elsif ( $code =~ /\+/ ) { $code = '+' }
	else { $code = ' '; }
}

sub on_ping {
	
}

sub start_ping {
	my ($kernel) = ($_[KERNEL]);
	@pings = ();
	$kernel->delay( auto_ping => 5);
}

sub stop_ping {
	my ($kernel) = ($_[KERNEL]);
	$kernel->delay( auto_ping => undef );
}


sub on_pong {
	my ($kernel) = ($_[KERNEL]);
	my $ping = shift(@pings);
	my $lag = time() - $ping;
#	print "Pong $lag\n";
	$kernel->delay( auto_ping => 30 );
	$kernel->delay( ping_timeout => undef );
}

sub on_nicktaken {
	$conn->yield( nick => $conn->nick_name() . "_");
}

# Note: Nick managment is now done by POE::Component::IRC::State
sub on_endwho {
	my ($server) = @_[ARG0];
}

sub on_connect {
	my ($kernel) = ($_[KERNEL]);
	print "Connected!\n";
	$server_failures{$servers[0]} = 0;
	start_ping(@_);

	$conn->yield( join => $Core::channel );
}

sub on_disconnect {
	my ($kernel) = ($_[KERNEL]);
	print "IRC disconnected\n";
	$server_failures{$servers[0]} += 1;
	rotate_server();
	if($server_failures{$servers[0]} >= $Core::maxretries) {
		print "Retrying in $Core::cooldowntime seconds\n";
		$kernel->alarm( retry_connect => time() + $Core::cooldowntime);
	}
	else {
		try_connect();
	}
}

sub on_socketerr {
	my ($reason, $kernel) = (@_[ARG0], $_[KERNEL]);
	print "Socket error: $reason\n";
	$server_failures{$servers[0]} += 1;
	rotate_server();
	if($server_failures{$servers[0]} >= 3) {
		print "Retrying in 30 seconds\n";
		$kernel->alarm( retry_connect => time() + 30);
	}
	else {
		try_connect();
	}
}

# IRC server tells us too screw up ...
sub on_error {
	my ($reason, $kernel) = (@_[ARG0], $_[KERNEL]);
	print "IRC server error: $reason\n";

	$server_failures{$servers[0]} += 1;

	rotate_server();
	try_connect();
}

# Called every loop iteration
sub on_idle
{
	do_callback('idle');
}

# Recieved a notice message
sub on_notice
{
	my ($user, $recipients, $text) = @_[ARG0..ARG2];
	my $nick = parse_user($user);

	do_callback('notice', [$nick, $text]);
}

# Whenever someone/server changed any channel/user modes
sub on_mode
{
	my ($user, $channel, $modestring) = @_[ARG0..ARG2];
	my $nick = parse_user($user);
	do_callback('mode', [$nick, $channel, $modestring, [ @_[ARG3..$#_] ]] );
}

# Somebody has used '/me' command (CTCP action in general)
#sub on_caction
#{
#	my $event = $_[1];
#	if ($event->{to}[0] eq $Core::channel) {
#		do_callback('me', [$event->{nick}, $event->{args}[0]]);
#	}
#
#	do_callback('caction', [$event->{from}, $event->{to}, $event->{args}[0]]);
#}

# No topic set after joining channel
sub on_notopic
{
	do_callback('notopic');
}

# Somebody has changed the topic
sub on_topic
{
	my ($user, $channel, $topic) = @_[ARG0..ARG2];
	my $nick = parse_user($user);
	print "topic $user $topic\n";
	do_callback('topic', [$nick, $topic]);
}

# Somebody has joined the channel (including the bot itself)
sub on_join {
	my ($user, $channel) = (@_[ARG0..ARG1]);
	my ($nick, $username, $host) = parse_user($user);
	do_callback('join', [$nick, $username, $host]);
}

# Somebody on the channel has changed their nickname (including the bot)
sub on_nick
{
	my ($user, $newnick) = @_[ARG0, ARG1];
	my $nick = parse_user($user);

	do_callback('nick', [$nick, $newnick]);
}

# Somebody has quit
sub on_quit
{
	my ($user, $message) = @_[ARG0, ARG1];
	my $nick = parse_user($user);
	do_callback('quit', [$nick, $message]);
}

# Somebody was kicked from the channel
sub on_kick
{
	my ($user, $channel, $victim, $reason) = @_[ARG0..ARG3];
	my $nick = parse_user($user);
	do_callback('kick', [$nick, $victim, $reason]);
}

# Somebody left our channel
sub on_part
{
	my ($user, $channel, $reason) = @_[ARG0..ARG2];
	my $nick = parse_user($user);
	do_callback('part', [$nick, $reason]);
}

# Private message received
sub on_privmsg
{
	my ($user, $recipients, $text) = @_[ARG0..ARG2];
	my $nick = parse_user($user);
	do_callback('privmsg', [$nick, $text]);
}

sub cleanup
{
	print "Cleaning up!\n";
	do_callback('cleanup');
	undef $conn;
	undef $poe_kernel;
	exit(1);
}

#$poe_kernel->run();
${$poe_kernel->[POE::Kernel::KR_RUN]} |= POE::Kernel::KR_RUN_CALLED;
while(1) {
	POE::Kernel->run_one_timeslice();
}
